perm filename CMS2B[T,LSP] blob
sn#649106 filedate 1982-03-15 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 R T=0.01/0.02 07:09:50
C00004 00003 PL/I OPTIMIZING COMPILE 3.0 PTF 69 TIME: 00.26
C00039 00004 MARCDO: PROCEDURE OPTIONS (MAIN)
C00062 ENDMK
C⊗;
R; T=0.01/0.02 07:09:50
.λ
DMSLIO740I EXECUTION BEGINS...
1002ad
2408aklmnopr
2453abc
2603abc
3003abc
6004adtx
6505abxyz
7006adlpst
TAG LENGTH POSITION
001 0013 00000
008 0041 00013
020 0015 00054
050 0021 00069
082 0012 00090
100 0020 00102
245 0024 00122
250 0014 00146
260 0050 00160
300 0031 00210
350 0010 00241
500 0059 00251
650 0014 00310
10aMaisel, Edward.↔
10aTai chi for health.↔
0 aNew York,bHolt, Rinehart and Winstonc1972~↔
axi, 212 p.billus.c24 cm.↔
0aExercise.∧
R; T=1.19/2.43 07:10:41
.λ
PL/I OPTIMIZING COMPILE 3.0 PTF 69 TIME: 00.26
.18 DATE: 22 FEB 82 PAGE 1
OPTIONS SPECIFIED
OP OPT(2) F(I) S AG C GS MI('|') IS LC(60) NEST STMT NNUM LMSG STG;
OPTIONS USED
AGGREGATE NOATTRIBUTES CHARSET(60,EBCDIC)
COMPILE NOCOUNT FLAG(I)
GOSTMT NODECK LINECOUNT(60)
INSOURCE NOESD MARGINI('|')
LMESSAGE NOFLOW MARGINS(2,72,0)
NEST NOGONUMBER OPTIMIZE(TIME)
OBJECT NOIMPRECISE SEQUENCE(73,80)
OPTIONS NOINCLUDE SIZE(645784)
SOURCE NOINTERRUPT NOSYNTAX(S)
STMT NOLIST TERMINAL(NOAGGREGATE,
STORAGE NOMACRO NOATTRIBUTES,
NOMAP NOESD,
NOMDECK NOINSOURCE,
NONUMBER NOLIST,
NOOFFSET NOMAP,
NOXREF NOOFFSET,
NOOPTIONS,
NOSOURCE,
NOSTORAGE,
NOXREF)
PL/I OPTIMIZING COMPILER MARCDO: PROCEDURE OPTIONS (MAIN);
PAGE 2
SOURCE LISTING
STMT LEV NT
1 0 | MARCDO: PROCEDURE OPTIONS (MAIN);
|CMS00010
| /*THIS PROGRAM READS A LIBRARY INSTRUCTION DECKLET, PRINTS
|CMS00020
| IT OUT FROM THE STRUCTURE WHERE IT HAS BEEN STORED, AND
|CMS00030
| PRINTS OUT THE RECORD DIRECTORY*/
|CMS00040
|
|CMS00050
2 1 0 | DECLARE
|CMS00060
| 1 DECKLET,
|CMS00070
| 2 CARDLET, /*SET OF MARC SPECS*/
|CMS00080
| 3 TAG CHAR(3),
|CMS00090
| 3 SIZE CHAR(1),
|CMS00100
| 3 SUBF CHAR(16) VARYING,
|CMS00110
| EOF BIT(1) INIT('0'B),
|CMS00120
| RECS FILE RECORD SEQUENTIAL, /*FILE CONTAINING DECKLETS*
/ |CMS00130
| (SYSIN, SYSPRINT) FILE STREAM,
|CMS00140
| SUBSTR BUILTIN,
|CMS00150
| INDEX BUILTIN,
|CMS00160
| MARC FILE RECORD SEQUENTIAL;
|CMS00170
3 1 0 | CALL DECKIT; /*ROUTINE TO READ IN AND PRINT OUT DECKLET*/
|CMS00180
4 1 0 | CALL MARCDIR; /*ROUTINE TO EXTRACT RECORD DIRECTORY*/
|CMS00190
5 1 0 | RETURN; /*RETURN CONTROL TO CMS*/
|CMS00200
|
|CMS00210
6 1 0 | DECKIT: PROCEDURE;
|CMS00220
| /*THIS ROUTINE READS THE INFORMATION FROM THE DECKLET INTO
|CMS00230
| A STRUCTURE AND THEN PRINTS IT OUT*/
|CMS00240
7 2 0 | ON ENDFILE (SYSIN) EOF = '1'B;
|CMS00250
8 2 0 | OPEN FILE (RECS) OUTPUT;
|CMS00260
|
|CMS00270
9 2 0 | DO WHILE (↑EOF);
|CMS00280
10 2 1 | GET SKIP EDIT (DECKLET.CARDLET) (A(3),A(1),A(16));
|CMS00290
11 2 1 | IF EOF THEN LEAVE;
|CMS00300
12 2 1 | WRITE FILE (RECS) FROM (DECKLET); /*CREATE RECORD*/
|CMS00310
13 2 1 | END;
|CMS00320
|
|CMS00330
14 2 0 | CLOSE FILE (RECS);
|CMS00340
|
|CMS00350
15 2 0 | EOF = '0'B; /*RESET END FLAG*/
|CMS00360
16 2 0 | ON ENDFILE (RECS) EOF = '1'B;
|CMS00370
17 2 0 | OPEN FILE (RECS) INPUT; /*OPEN FILE OF SPECS FOR INPUT*/
|CMS00380
18 2 0 | DO WHILE (↑EOF);
|CMS00390
19 2 1 | READ FILE (RECS) INTO (DECKLET.CARDLET);
|CMS00400
20 2 1 | IF EOF THEN LEAVE;
|CMS00410
21 2 1 | PUT SKIP EDIT (DECKLET.CARDLET) (A);
|CMS00420
22 2 1 | END;
|CMS00430
23 2 0 | CLOSE FILE (RECS);
|CMS00440
24 2 0 | RETURN; /*RETURN TO MAIN PROGRAM*/
|CMS00450
25 2 0 | END DECKIT;
|CMS00460
|
|CMS00470
26 1 0 | MARCDIR: PROCEDURE;
|CMS00480
| /*THIS ROUTINE EXTRACTS AND PRINTS OUT THE MARC RECORD
|CMS00490
| DIRECTORY AND SUBFIELDS INDICATED BY DECKLET*/
|CMS00500
|
|CMS00510
PL/I OPTIMIZING COMPILER MARCDO: PROCEDURE OPTIONS (MAIN);
PAGE 3
STMT LEV NT
27 2 0 | DECLARE
|CMS00520
| 1 DECKLET,
|CMS00530
| 2 CARDLET, /*SET OF MARC SPECS*/
|CMS00540
| 3 TAG CHAR(3),
|CMS00550
| 3 SIZE CHAR(1),
|CMS00560
| 3 SUBF CHAR(16) VARYING,
|CMS00570
| (I,J,K,L) FIXED BIN (15),
|CMS00580
| AREA CHAR(2000) VARYING,
|CMS00590
| FIELD(50) CHAR(12),
|CMS00600
| PRINT BIT(1),
|CMS00610
| LENGTH FIXED BIN(15),
|CMS00620
| START FIXED BIN(15),
|CMS00630
| DIR CHAR(500) VARYING; /*EXTRACTED DIRECTORY*/
|CMS00640
28 2 0 | OPEN FILE (MARC) INPUT; /*OPEN THE FILE OF MARC RECS FOR
INPUT*/ |CMS00650
29 2 0 | EOF = '0'B;
|CMS00660
|
|CMS00670
30 2 0 | PUT SKIP EDIT ('TAG','LENGTH','POSITION') (A(3),X(10),A(6
), |CMS00680
| X(10),A(8));
|CMS00690
|
|CMS00700
31 2 0 | DO;/*TRY THIS JUST ONCE*/
|CMS00710
32 2 1 | PUT SKIP (2);
|CMS00720
33 2 1 | READ FILE (MARC) INTO (AREA);
|CMS00730
34 2 1 | J = SUBSTR(AREA, 13, 5); /*GET STARTING POS. OF CONTROL
|CMS00740
| FIELDS*/
|CMS00750
35 2 1 | DIR = SUBSTR(AREA, 25, J-25); /*EXTRACT DIRECTORY*/
|CMS00760
36 2 1 | L = 1;
|CMS00770
37 2 1 | PUT SKIP DATA (J);
|CMS00780
38 2 1 | CHOP: /*DIVIDE INTO BLOCKS & PRINT*/
|CMS00790
| DO K = 1 TO (J-25)/12;
|CMS00800
39 2 2 | CALL PRINTFRM (SUBSTR(DIR,L,3),SUBSTR(DIR,L+3,4),
|CMS00810
| SUBSTR(DIR,L+7,5));
|CMS00820
40 2 2 | FIELD(K) = SUBSTR(DIR,L,12);/*START FILLING ARRAY
|CMS00830
| WITH FIELDS*/
|CMS00840
41 2 2 | PUT SKIP DATA (FIELD(K));
|CMS00850
42 2 2 | PUT SKIP DATA (DIR);
|CMS00860
43 2 2 | L = L + 12; /*SKIP TO NEXT 12 CHARACTERS*/
|CMS00870
44 2 2 | END CHOP;
|CMS00880
45 2 1 | CALL FLDPRT (FIELD,DECKLET,K,PRINT,J,AREA);
|CMS00890
46 2 1 | END;
|CMS00900
47 2 0 | CLOSE FILE (MARC);
|CMS00910
48 2 0 | RETURN;/*RETURN TO MAIN PROGRAM*/
|CMS00920
49 2 0 | END MARCDIR;
|CMS00930
|
|CMS00940
| /*SUBROUTINE TO FORMAT DIRECTORY*/
|CMS00950
50 1 0 | PRINTFRM: PROCEDURE (TAG,LEN,POS);
|CMS00960
51 2 0 | DCL
|CMS00970
| TAG CHAR (3),
|CMS00980
| LEN CHAR (4),
|CMS00990
| POS CHAR (5);
|CMS01000
|
|CMS01010
52 2 0 | PUT SKIP EDIT (TAG,LEN,POS)(A(3), X(11),A(4),X(13),A(5
)); |CMS01020
53 2 0 | RETURN;
|CMS01030
54 2 0 | END PRINTFRM;
|CMS01040
|
|CMS01050
PL/I OPTIMIZING COMPILER MARCDO: PROCEDURE OPTIONS (MAIN);
PAGE 4
STMT LEV NT
| /*SUBROUTINE TO PRINT OUT FIELDS LISTED IN DECKLET*/
|CMS01060
55 1 0 | FLDPRT: PROCEDURE (FIELD,DECKLET,K,PRINT,J,AREA);
|CMS01070
56 2 0 | DECLARE
|CMS01080
| 1 DECKLET CONNECTED,
|CMS01090
| 2 CARDLET, /*SET OF MARC SPECS*/
|CMS01100
| 3 TAG CHAR(3),
|CMS01110
| 3 SIZE CHAR(1),
|CMS01120
| 3 SUBF CHAR(16) VARYING,
|CMS01130
| FIELD(*) CHAR(12),
|CMS01140
| K FIXED BIN(15),
|CMS01150
| J FIXED BIN(15),
|CMS01160
| START FIXED BIN(15),
|CMS01170
| LENGTH FIXED BIN(15),
|CMS01180
| AREA CHAR(2000) VARYING,
|CMS01190
| N FIXED BIN(15);
|CMS01200
|
|CMS01210
57 2 0 | EOF = '0'B;
|CMS01220
58 2 0 | N = 1;
|CMS01230
59 2 0 | ON ENDFILE (RECS) EOF = '1'B;
|CMS01240
60 2 0 | OPEN FILE (RECS) INPUT;
|CMS01250
61 2 0 | PUT SKIP DATA (FIELD(K));
|CMS01260
|
|CMS01270
62 2 0 | DO WHILE (↑EOF);
|CMS01280
63 2 1 | READ FILE (RECS) INTO (DECKLET.CARDLET);
|CMS01290
64 2 1 | PUT SKIP DATA (SIZE);
|CMS01300
65 2 1 | IF EOF THEN LEAVE;
|CMS01310
66 2 1 | DO WHILE N < K;
|CMS01320
67 2 2 | PUT SKIP DATA (TAG);
|CMS01330
68 2 2 | PUT SKIP DATA (FIELD(N));
|CMS01340
69 2 2 | IF (TAG = SUBSTR(FIELD(N),1,3) THEN
|CMS01350
| DO;
|CMS01360
70 2 2 | START = SUBSTR(FIELD(K),8,5) + J + 1;
|CMS01370
71 2 2 | LENGTH = SUBSTR(FIELD(K),4,4);
|CMS01380
72 2 2 | PUT SKIP EDIT (SUBSTR(AREA,START,LENGTH)
|CMS01390
| (A(LENGTH));
|CMS01400
73 2 2 | END;
|CMS01410
74 2 1 | END;
|CMS01420
75 2 0 | END;
|CMS01430
76 1 0 | CLOSE FILE (RECS);
|CMS01440
77 1 0 | RETURN;
|CMS01450
78 1 0 | END FLDPRT;
|CMS01460
79 1 0 | END MARCDO;
|CMS01470
PL/I OPTIMIZING COMPILER MARCDO: PROCEDURE OPTIONS (MAIN);
PAGE 5
AGGREGATE LENGTH TABLE
DCL NO. IDENTIFIER LVL DIMS OFFSET ELEMENT
TOTAL
LENGTH.
LENGTH.
2 DECKLET 1 22
22
CARDLET 2 22
22
TAG 3 3
SIZE 3 3 1
SUBF 3 4 18
27 DECKLET 1 22
22
CARDLET 2 22
22
TAG 3 3
SIZE 3 3 1
SUBF 3 4 18
56 DECKLET 1 PARAM
PARAM
CARDLET 2 PARAM
PARAM
TAG 3 PARAM
SIZE 3 3 PARAM
SUBF 3 4 PARAM
27 FIELD 1 12
600
56 FIELD 1 12
PARAM
SUM OF CONSTANT LENGT
HS 644
PL/I OPTIMIZING COMPILER MARCDO: PROCEDURE OPTIONS (MAIN);
PAGE 6
STORAGE REQUIREMENTS
BLOCK, SECTION OR STATEMENT TYPE LENGTH (HEX) DSA SIZE
(HEX)
*MARCDO1 PROGRAM CSECT 3416 D58
*MARCDO2 STATIC CSECT 1620 654
MARCDO PROCEDURE BLOCK 178 B2 272
110
DECKIT PROCEDURE BLOCK 622 26E 328
148
7 ON UNIT 124 7C 232
E8
16 ON UNIT 124 7C 232
E8
MARCDIR PROCEDURE BLOCK 1120 460 3576
DF8
PRINTFRM PROCEDURE BLOCK 296 128 304
130
FLDPRT PROCEDURE BLOCK 824 338 384
180
59 ON UNIT 124 7C 232
E8
PL/I OPTIMIZING COMPILER MARCDO: PROCEDURE OPTIONS (MAIN);
PAGE 7
COMPILER DIAGNOSTIC MESSAGES
ERROR ID L STMT MESSAGE DESCRIPTION
SEVERE AND ERROR DIAGNOSTIC MESSAGES
IEL0280I E 66 LEFT PARENTHESIS ASSUMED AFTER 'DO WHILE'.
IEL0400I E 66 RIGHT PARENTHESIS ASSUMED AFTER 'DO WHILE N < K'.
IEL0247I S 69 INVALID SYNTAX IN 'IF' STATEMENT EXPRESSION. '(TAG = SUB
STR(FIELD(N),1,3) THEN
DO' HAS BEEN REPLACED BY 1.
IEL0271I S 69 KEYWORD 'THEN' ASSUMED AFTER 'DO' IN 'IF' STATEMENT.
IEL0400I E 69 RIGHT PARENTHESIS ASSUMED AFTER 'UBSTR(FIELD(N),1,3)'.
IEL0306I S 72 EDIT DATA LIST HAS NO MATCHING FORMAT LIST AFTER ',LENGTH)
(A(LENGTH))'. 'A' FORMAT ASSUMED.
IEL0400I E 72 RIGHT PARENTHESIS ASSUMED AFTER ',LENGTH) (A(LENGTH))'.
IEL0500I S 72 CONFLICT BETWEEN USE OF 'SUBSTR' AS 'ENTRY' AND ITS DECLARE
D ATTRIBUTES. STATEMENT IGNORED.
IEL0503I E 72 IDENTIFIER 'A' IS NOT DECLARED. EXTERNAL ENTRY ASSUMED.
IEL0268I S 78 LABEL REFERENCED BY 'END' STATEMENT CANNOT BE MATCHED. R
EFERENCE IGNORED.
IEL0289I S 78 LOGICAL END OF PROGRAM FOUND BEFORE END OF SOURCE TEXT.
STATEMENT IGNORED.
WARNING DIAGNOSTIC MESSAGES
IEL0916I W 1 ITEM(S) 'DECKLET.CARDLET.SIZE','DECKLET.CARDLET.TAG','DECKL
ET.CARDLET.SUBF' MAY BE UNINITIALIZED
WHEN USED IN THIS BLOCK.
IEL0916I W 26 ITEM(S) 'PRINT','DECKLET.CARDLET.TAG','DECKLET.CARDLET.SUBF
','FIELD','DECKLET.CARDLET.SIZE' MAY BE
UNINITIALIZED WHEN USED IN THIS BLOCK.
IEL0671I W 45 ARGUMENT NUMBER 4 TO ENTRY 'FLDPRT' DOES NOT MATCH ITS CORR
ESPONDING PARAMETER OR IS AN
ISUB-DEFINED ARRAY. A DUMMY ARGUMENT HAS BEEN CREATED.
IEL0768I W 69 CONSTANT SPECIFIED WHERE EXPRESSION EXPECTED. FLOW OF CO
NTROL WILL BE UNCONDITIONAL.
IEL0914I W 76, 77 STATEMENT MAY NEVER BE EXECUTED.
PL/I OPTIMIZING COMPILER MARCDO: PROCEDURE OPTIONS (MAIN);
PAGE 8
ERROR ID L STMT MESSAGE DESCRIPTION
COMPILER INFORMATORY MESSAGES
IEL0533I I NO 'DECLARE' STATEMENT(S) FOR 'A'.
IEL0541I I 1, 6, 7, 16, 26, 50, 55, 59 'ORDER' OPTION APPLIES TO THIS BLOCK
. OPTIMIZATION MAY BE INHIBITED.
IEL0906I I 34, 70, 71 DATA CONVERSION WILL BE DONE BY SUBROUTINE CALL.
IEL0534I I 55 NO 'DECLARE' STATEMENT(S) FOR PARAMETER(S) 'PRINT'.
END OF COMPILER DIAGNOSTIC MESSAGES
COMPILE TIME 0.04 MINS SPILL FILE: 0 RECORDS, SIZE 3491
R; T=0.21/1.29 00:44:04
.λ
MARCDO: PROCEDURE OPTIONS (MAIN);
/*THIS PROGRAM READS A LIBRARY INSTRUCTION DECKLET, PRINTS
IT OUT FROM THE STRUCTURE WHERE IT HAS BEEN STORED, AND
PRINTS OUT THE RECORD DIRECTORY*/
DECLARE
1 DECKLET,
2 CARDLET, /*SET OF MARC SPECS*/
3 TAG CHAR(3),
3 SIZE CHAR(1),
3 SUBF CHAR(16) VARYING,
3 SUBF CHAR(16) VARYING,
RECS FILE RECORD SEQUENTIAL, /*FILE CONTAINING DECKLETS*/
(SYSIN, SYSPRINT) FILE STREAM,
SUBSTR BUILTIN,
INDEX BUILTIN,
MARC FILE RECORD SEQUENTIAL;
CALL DECKIT; /*ROUTINE TO READ IN AND PRINT OUT DECKLET*/
CALL MARCDIR; /*ROUTINE TO EXTRACT RECORD DIRECTORY*/
RETURN; /*RETURN CONTROL TO CMS*/
DECKIT: PROCEDURE;
/*THIS ROUTINE READS THE INFORMATION FROM THE DECKLET INTO
A STRUCTURE AND THEN PRINTS IT OUT*/
ON ENDFILE (SYSIN) EOF = '1'B;
OPEN FILE (RECS) OUTPUT;
DO WHILE (↑EOF);
GET SKIP EDIT (DECKLET.CARDLET) (A(3),A(1),A(16));
IF EOF THEN LEAVE;
WRITE FILE (RECS) FROM (DECKLET); /*CREATE RECORD*/
END;
CLOSE FILE (RECS);
EOF = '0'B; /*RESET END FLAG*/
ON ENDFILE (RECS) EOF = '1'B;
OPEN FILE (RECS) INPUT; /*OPEN FILE OF SPECS FOR INPUT*/
DO WHILE (↑EOF);
READ FILE (RECS) INTO (DECKLET.CARDLET);
IF EOF THEN LEAVE;
PUT SKIP EDIT (DECKLET.CARDLET) (A);
END;
CLOSE FILE (RECS);
RETURN; /*RETURN TO MAIN PROGRAM*/
END DECKIT;
MARCDIR: PROCEDURE;
/*THIS ROUTINE EXTRACTS AND PRINTS OUT THE MARC RECORD
DIRECTORY AND SUBFIELDS INDICATED BY DECKLET*/
DECLARE
1 DECKLET,
2 CARDLET, /*SET OF MARC SPECS*/
3 TAG CHAR(3),
3 SIZE CHAR(1),
3 SUBF CHAR(16) VARYING,
(I,J,K,L) FIXED BIN (15),
AREA CHAR(2000) VARYING,
FIELD(50) CHAR(12),
PRINT BIT(1),
LENGTH FIXED BIN(15),
START FIXED BIN(15),
DIR CHAR(500) VARYING; /*EXTRACTED DIRECTORY*/
OPEN FILE (MARC) INPUT; /*OPEN THE FILE OF MARC RECS FOR INPUT*/
EOF = '0'B;
PUT SKIP EDIT ('TAG','LENGTH','POSITION') (A(3),X(10),A(6),
X(10),A(8));
DO;/*TRY THIS JUST ONCE*/
PUT SKIP (2);
READ FILE (MARC) INTO (AREA);
J = SUBSTR(AREA, 13, 5); /*GET STARTING POS.
CHOP: /*DIVIDE INTO BLOCKS & PRINT*/
DO K = 1 TO (J-25)/12;
CALL PRINTFRM (SUBSTR(DIR,L,3),SUBSTR(DIR,L+3,4),
SUBSTR(DIR,L+7,5));
FIELD(K) = SUBSTR(DIR,L,12);/*START FILLING ARRAY
WITH FIELDS*/
PUT SKIP DATA (FIELD(K));
PUT SKIP DATA (DIR);
L = L + 12; /*SKIP TO NEXT 12 CHARACTERS*/
END CHOP;
CALL FLDPRT (FIELD,DECKLET,K,PRINT,J,AREA);
END;
CLOSE FILE (MARC);
RETURN;/*RETURN TO MAIN PROGRAM*/
END MARCDIR;
/*SUBROUTINE TO FORMAT DIRECTORY*/
PRINTFRM: PROCEDURE (TAG,LEN,POS);
DCL
TAG CHAR (3),
LEN CHAR (4),
POS CHAR (5);
PUT SKIP EDIT (TAG,LEN,POS)(A(3), X(11),A(4),X(13),A(5));
RETURN;
END PRINTFRM;
/*SUBROUTINE TO PRINT OUT FIELDS LISTED IN DECKLET*/
FLDPRT: PROCEDURE (FIELD,DECKLET,K,PRINT,J,AREA);
DECLARE
1 DECKLET CONNECTED,
2 CARDLET, /*SET OF MARC SPECS*/
3 TAG CHAR(3),
3 SIZE CHAR(1),
3 SUBF CHAR(16) VARYING,
FIELD(*) CHAR(12),
K FIXED BIN(15),
J FIXED BIN(15),
POS FIXED BIN(15),
START FIXED BIN(15),
LENGTH FIXED BIN(15),
AREA CHAR(2000) VARYING,
N FIXED BIN(15);
EOF = '0'B;
N = 1;
ON ENDFILE (RECS) EOF = '1'B;
OPEN FILE (RECS) INPUT;
PUT SKIP DATA (FIELD(K));
DO WHILE (↑EOF);
READ FILE (RECS) INTO (DECKLET.CARDLET);
PUT SKIP DATA (SIZE);
IF EOF THEN LEAVE;
DO WHILE N < K;
PUT SKIP DATA (TAG);
PUT SKIP DATA (FIELD(N));
IF (TAG = SUBSTR(FIELD(N),1,3)
DO;
START = SUBSTR(FIELD(N),8,5) + J;
LENGTH = SUBSTR(FIELD(N),4,4);
PUT SKIP EDIT (SUBSTR(AREA,START,LENGTH))
(A(LENGTH));
END;
END;
END;
CLOSE FILE (RECS);
RETURN;
END FLDPRT;
/*THIS PROCEDURE COMPARES THE TAG FROM DECKLET
WITH THE TAGS IN THE FIELD ARRAY. IF IDENTIFICATION
IS POSITIVE IT SIGNALS THE PROGRAM TO PRINT OUT THE
FIELD*/
MATCH: PROCEDURE (FIELD,DECKLET,K,PRINT);
DECLARE
1 DECKLET CONNECTED,
2 CARDLET, /*SET OF MARC SPECS*/
3 TAG CHAR(3),
3 SIZE CHAR(1),
3 SUBF CHAR(16) VARYING,
FIELD(*) CHAR(12),
K FIXED BIN(15),
J FIXED BIN(15),
START FIXED BIN(15),
LENGTH FIXED BIN(15),
AREA CHAR(2000) VARYING,
TRUE BIT(1) INIT ('1'B),
FALSE BIT(1) INIT ('0'B),
PRINT BIT(1);
/*INITIALIZE VARIABLES*/
N=1;
GOGOGO = TRUE;
PRINT = FALSE;
PUT SKIP DATA (TAG);
DO WHILE ((N <= K) & GOGOGO);
IF (TAG = SUBSTR(FIELD(N),1,3)) THEN
DO;
GOGOGO = FALSE;/*FLAG TO STOP COMPARISON*/
PRINT = TRUE;/*FLAG TO PRINT FIELD*/
END;
N = N + 1;
END;
RETURN;
END MATCH;
END MARCDO;